home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0128_Another Fire Graphic.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  9KB  |  200 lines
  1. {
  2. AC>I got my hands on Jare's fire code and thought it was pretty cool,
  3. AC>so I made my own fire program. Although it didn't turn out like I
  4. AC>thought it would (like Jare's) what I have is (at least I think so)
  5. AC>something that looks more realistic.
  6.  
  7. This is kinda funny... just the other day I was looking at Jare's fire
  8. code, and did an 80x50 textmode version of it in C.  I did a quick and
  9. dirty conversion of it to Pascal so I could post it here for you
  10. (don't you feel special? <G>).  The pascal version came out a bit
  11. slower then my C version, although they are very similar. I haven't
  12. figured out why though... most times I try this, both come out close
  13. to the same speed.
  14.  
  15. (********************************************************************
  16.  Fire by Eric Coolman (aka. Digitar/SKP), Simple Minded Software
  17.  Much like Jare's (VangelisTeam) fire, but uses 80x50x16 text mode
  18.  rather than 320x200x256 (which was "tweaked" to look like 80x50
  19.  text mode).  Reference : FIRE.TXT by Phil Carlisle (aka Zoombapup,
  20.  CodeX) from PC Game Programmer's Encyclopedia (PCGPE10.ZIP) by Mark
  21.  Feldman and contributers (thanks for the great reads guys!).
  22.  Compiler : Turbo Pascal 6.0
  23.  Released to public domain, July 30, 1994.
  24.  
  25.  NOTE: FirePalette will not get loaded if running under DESQview
  26.        with "VIRTUALIZE TEXTMODE" on (which will stop any palette
  27.        manipulation).  To fix, go into setup for the DOSBOX, and
  28.        under "VIRTUALIZE TEXT/GRAPHICS" mode, and set it to "N".
  29.        Also for DV, set "WRITES DIRECT TO SCREEN" to "Y"es.
  30. ********************************************************************)
  31. }
  32.  
  33. Program tFire;
  34.  
  35. const
  36.     MAXX = 80;
  37.     MAXY = 50;
  38.     { Our gradient firepalette (white/yellow/red/orange/slate/black) }
  39.     FirePal : array[0..3*16-1] of byte =
  40.       {       [ HUES ]       }
  41.       {  RED    GREEN   BLUE }
  42.       {  ===    =====   ==== }
  43.       (                                               { Normal Color }
  44.          0,     0,      0,                            { BLACK        }
  45.          0,     5,      3,                            { BLUE         }
  46.          0,     6,      7,                            { GREEN        }
  47.          0,     7,      9,                            { CYAN         }
  48.          0,     8,      11,                           { RED          }
  49.          0,     9,      12,                           { MAGENTA      }
  50.          63,    13,     0,                            { BROWN        }
  51.          60,    4,      4,                            { LIGHTGRAY    }
  52.          63,    58,     21,                           { DARKGRAY     }
  53.          63,    59,     0,                            { LIGHTBLUE    }
  54.          63,    60,     0,                            { LIGHTGREEN   }
  55.          63,    60,     0,                            { LIGHTCYAN    }
  56.          63,    61,     30,                           { LIGHTRED     }
  57.          63,    55,     42,                           { LIGHTMAGENTA }
  58.          63,    60,     55,                           { YELLOW       }
  59.          63,    63,     63                            { WHITE        }
  60.      );
  61.  
  62. type
  63.      ColorArray = array [0..MAXX+1, 0..MAXY] of Byte;
  64. var
  65.     FireImage : ColorArray;
  66.     CUR       : Word;                                { working color }
  67.     x, y      : Byte;                             { general counters }
  68.  
  69. (*
  70.  Sets video mode.  If mode is 64d (40h), 8x8 ROM font will be loaded
  71.  and 80x50 textmode will be activated.  Any other value will set
  72.  mode normally.
  73. *)
  74. procedure VidMode(mode : byte); assembler;
  75. asm
  76.      cmp  mode, 40h                      { (64d) want 80x50/43 mode? }
  77.      jnz  @normalset
  78.      mov  ax,1112h                { set 8 point font as current font }
  79.      mov  bl,00h
  80.      jmp  @MakeItSo                                            { ;-) }
  81.    @normalset:
  82.      mov  ah, 00h
  83.      mov  al, mode
  84.    @MakeItSo:
  85.      int  10h
  86. end;
  87.  
  88. { grabs and dumps keypress...returns 1 if a key was hit, else 0 }
  89. function KbGrab : boolean;
  90. var
  91.     WasHit : boolean;
  92. begin
  93.     WasHit := False;
  94.  
  95.     asm
  96.         mov ax, 0100h
  97.         int 16h
  98.         lahf
  99.         test ah, 40h
  100.         jnz @done
  101.         inc WasHit
  102.         mov ax, 0000h                  { grab the key they hit .... }
  103.         int 16h
  104.       @done:
  105.     end;
  106.     KbGrab := WasHit;
  107. end;
  108.  
  109. (*********************************************************************
  110.  sets only color indexes normally used in textmode (16 of 'em).
  111.  Note the heavy use of ternary operator there... what that means
  112.  is - indexes 7 to 15 (dark gray to white) are actually indexes
  113.  55 to 63, and index 6 (dark brown) is actually 20d (14h) because
  114.  it uses the secondary hues so that it doesn't look too much like
  115.  red.  The rest (0,1,2,4,5,7) are as expected.
  116. *********************************************************************)
  117. procedure SetFirePal;
  118. var
  119.   i, j : Byte;
  120. begin
  121.    for i:= 0 to 16 do                               { for each index }
  122.      begin
  123.        if i <= 7 then begin if i = 6 then j := 20 else j := i; end
  124.        else j := i+48;
  125.        port[$3c8] := j;                             { Send the index }
  126.        port[$3c9] := FirePal[i*3];                    { Send the red }
  127.        port[$3c9] := FirePal[i*3+1];                { Send the green }
  128.        port[$3c9] := FirePal[i*3+2];                 { Send the blue }
  129.     end;
  130. end;
  131.  
  132.  
  133. (*********************************************************************
  134.   +----+-----+----+ Table to left are screen ofs's surrounding CUR(0).
  135.   |-81 | -80 |-79 | That we will take average of. 80 is for width of
  136.   +----+-----+----+ screen in chars in textmode (also width of our
  137.   | -1 | CUR | +1 | screen buffer).  The calculated average will be
  138.   +----+-----+----+ assigned to spot '-80' to move the fire upwards,
  139.   |+79 | +80 |+81 | and decremented to fade it out (like a plasma
  140.   +----+-----+----+ effect somewhat).
  141. *********************************************************************)
  142. procedure DoFire;
  143. begin;
  144.     { start at [1,1] or above because 0,0 doesn't have 8 surrounding }
  145.     { stop x at 78 or less for the same reason (ending y doesn't     }
  146.     { matter cause we are setting max y randomly anyways).           }
  147.     { (starting y can be set to 8 to give room for a scroller).      }
  148.      for y := 1 to MAXY do
  149.        for x := 1 to MAXX-1 do
  150.          begin
  151.           { get average of 8 surrounding colors              (-ofs-) }
  152.           CUR := (  FireImage[x-1][y]         { direct to left  (-1) }
  153.                   + FireImage[x+1][y]         { direct to right (+1) }
  154.                   + FireImage[x][y-1]         { direct above   (-80) }
  155.                   + FireImage[x][y+1]         { direct below   (+80) }
  156.                   + FireImage[x-1][y-1]       { above to left  (-81) }
  157.                   + FireImage[x+1][y+1]       { below to right (+81) }
  158.                   + FireImage[x+1][y-1]       { above to right (-79) }
  159.                   + FireImage[x-1][y+1]       { below to left  (+79) }
  160.                 ) shr 3;                      { divide by 8          }
  161.          Dec(CUR);                            { make fire fade out   }
  162.          { notice below is assigning the average CUR to (CUR-1 line) }
  163.          { ... this keeps fire moving in upward direction.           }
  164.          FireImage[x][y-1] := CUR;                       { set color }
  165.          mem[$b800:y*160+(x shl 1)+1] := FireImage[x][y];
  166.        end;
  167.  
  168.        { Randomly set last line of fire... This keeps the fire going }
  169.       for x := 0 to 80 do
  170.          FireImage[x][49] := (random(255)+1);
  171.       { second last line also to give fire some more height. }
  172.       for x := 0 to 80 do
  173.          FireImage[x][48] := (random(255)+1);
  174. end;
  175.  
  176. begin
  177.    VidMode($03);                     { 80x25 mode (to clear screen) }
  178.    VidMode($40);                                       { 80x50 mode }
  179.  
  180.    SetFirePal;
  181.  
  182.   { change to hi-intense background so we have 16 bg colors to }
  183.   { work with.                                                 }
  184.   asm
  185.       mov ax, 1003h                                 { blinking attr }
  186.       mov bx, 0000h            { 0=HiIntBackground, 1=Blinking Attr }
  187.       int 10h
  188.   end;
  189.  
  190.   { clear fire image }
  191.   fillchar(FireImage, sizeof(FireImage), 63);     { fill with white }
  192.  
  193.   for x := 0 to 80 do          { set up last line to start the fire }
  194.     FireImage[x][49] := (random(255)+1);
  195.  
  196.   repeat DoFire; until KbGrab;
  197.  
  198.   VidMode($03);                                        { 80x25 mode }
  199. end.
  200.